unit MBImageLib;

interface

uses
  {DEFT} Windows, SysUtils, Classes, Graphics,
  {GR32} GR32, GR32_Png,
  {GREX} PngImage, Jpeg, GifImg;

const
  {Load Image Return Value}
  LIR_ER = 0;
  LIR_OK = 1;

  {Save Image Return Value}
  SIR_ER = 0;
  SIR_OK = 1;

type
  {Image Type}
  TImgType = ( itNone, itBMP, itPNG, itJPG, itGIF );

  {Image file load rutines}
  function CheckType( AFileName: widestring ): TImgType;
  function LoadToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function LoadBmpToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function LoadPngToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function LoadJpgToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function LoadGifToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function LoadGifToBitmap32Ex( AFileName: widestring; AFrameIndex: integer; ABitmap: TBitmap32 ): byte; overload;
  function LoadGifToBitmap32Ex( AGif: TGifImage; AFrameIndex: integer; ABitmap: TBitmap32 ): byte; overload;

  function SaveBitmap32ToBmp( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function SaveBitmap32ToPng( AFileName: widestring; ABitmap: TBitmap32 ): byte;
  function SaveBitmap32ToJpg( AFileName: widestring; ABitmap: TBitmap32; ACompress: byte = 100 ): byte;
  function SaveBitmap32ToGif( AFileName: widestring; ABitmap: TBitmap32 ): byte;

implementation

function CheckType( AFileName: widestring ): TImgType;
var
  Ext: widestring;
begin
  Ext := UpperCase( ExtractFileExt( AFileName ) );

  if Ext = '.BMP' then
    Result := itBMP
  else if Ext = '.PNG' then
    Result := itPNG
  else if Ext = '.JPG' then
    Result := itJPG
  else if Ext = '.JPEG' then
    Result := itJPG
  else if Ext = '.GIF' then
    Result := itGIF
  else
    Result := itNone;
end;

function LoadToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
begin
  case CheckType( AFileName ) of
    itBMP : Result := LoadBmpToBitmap32( AFileName, ABitmap );
    itPNG : Result := LoadPngToBitmap32( AFileName, ABitmap );
    itJPG : Result := LoadJpgToBitmap32( AFileName, ABitmap );
    itGIF : Result := LoadGifToBitmap32( AFileName, ABitmap );
  end;
end;


function LoadBmpToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
begin
  Result := LIR_ER;
  ABitmap.LoadFromFile( AFileName );
  Result := LIR_OK;
end;


function LoadPngToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
var
  Image: TPngObject;
  bResult: boolean;
  Tr: boolean;
//(*
  procedure _SetAlpha(_png: TPngObject; _bmp: TBitmap32);
  var
    ScanIndex, i: Integer;
    PxScan : PLongword;
    PxAlpha: PByte;
  begin
    _bmp.Width := _png.Canvas.ClipRect.Right;
    _bmp.Height := _png.Canvas.ClipRect.Bottom;
    _png.Draw( _bmp.Canvas, Rect( 0, 0, _png.Width, _png.Height ) );

    if ( _png.Header.ColorType = COLOR_RGBALPHA )or( _png.Header.ColorType = COLOR_GRAYSCALEALPHA ) then //begin
    else
      _png.CreateAlpha;

      for ScanIndex := 0 to _bmp.Height - 1 do begin
        PxScan := PLongword( _bmp.Scanline[ ScanIndex ] );
        PxAlpha:= @_png.AlphaScanline[ ScanIndex ][0];
        for i:= 0 to _bmp.Width - 1 do begin
          PxScan^:= (PxScan^ and $FFFFFF) or (Longword(Byte(PxAlpha^)) shl 24);
          Inc(PxScan);
          Inc(PxAlpha);
        end; {for-i}
      end; {for-ScanIndex}
    //end;
  end;
//*)
begin
(*
  Result := LIR_ER;
  LoadPNGintoBitmap32( ABitmap, AFileName, Tr );
  Result := LIR_OK;
*)
//(*
  Result := LIR_ER;
  bResult:= True;
  Image:= TPngObject.Create;
  Try
    Image.LoadFromFile( AFileName );
  except
    bResult:= False;
  end;

  if ( bResult ) then
    _SetAlpha( Image, ABitmap )
  else begin
    _SetAlpha( Image, ABitmap );
  end;

  Image.Free;
  Result := LIR_OK;
//*)
end;


function LoadJpgToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
var
  Jpg: TJpegImage;
begin
  Result := LIR_ER;
  ABitmap.LoadFromFile( AFileName );
  Result := LIR_OK;
end;


function LoadGifToBitmap32( AFileName: widestring; ABitmap: TBitmap32 ): byte;
var
  Gif: TGifImage;
begin
  Result := LIR_ER;
  try
    Gif := TGifImage.Create;
    Gif.LoadFromFile( AFileName );
    ABitmap.Assign( Gif.Bitmap );
    Result := LIR_OK;
  finally
    Gif.Free;
  end;
end;

function LoadGifToBitmap32Ex( AFileName: widestring; AFrameIndex: integer; ABitmap: TBitmap32 ): byte;
var
  Gif: TGifImage;
  Cnt: integer;
begin
  Result := LIR_ER;
  try
    Gif := TGifImage.Create;
    Gif.LoadFromFile( AFileName );

    Cnt := Gif.Images.Count;
    if AFrameIndex < Cnt then
      ABitmap.Assign( Gif.Images[ AFrameIndex ].Bitmap )
    else
      ABitmap.Assign( Gif.Bitmap );
    Result := Gif.Images.Count;
  finally
    Gif.Free;
  end;
end;

function LoadGifToBitmap32Ex( AGif: TGifImage; AFrameIndex: integer; ABitmap: TBitmap32 ): byte; overload;
var
  Cnt: integer;
begin
  Result := LIR_ER;
  Cnt := AGif.Images.Count;
  if AFrameIndex < Cnt then
    ABitmap.Assign( AGif.Images[ AFrameIndex ].Bitmap )
  else
    ABitmap.Assign( AGif.Bitmap );

  Result := LIR_OK;
end;


function SaveBitmap32ToBmp( AFileName: widestring; ABitmap: TBitmap32 ): byte;
begin
  Result := SIR_ER;
  ABitmap.SaveToFile( AFileName );
  Result := SIR_OK;
end;


function SaveBitmap32ToPng( AFileName: widestring; ABitmap: TBitmap32 ): byte;
begin
  Result := SIR_ER;
  GR32_Png.SaveBitmap32ToPNG( ABitmap, True, clWhite32, AFileName );
  Result := SIR_OK;
end;


function SaveBitmap32ToJpg( AFileName: widestring; ABitmap: TBitmap32; ACompress: byte  ): byte;
var
  Jpg: TJpegImage;
  Bmp: TBitmap;
begin
  Result := SIR_ER;
  try
    Jpg := TJpegImage.Create;
    Bmp := TBitmap.Create;

    Bmp.Handle := ABitmap.BitmapHandle;
    Jpg.Assign( Bmp );
    Jpg.CompressionQuality := ACompress;
    Jpg.SaveToFile( AFileName );
    Result := SIR_OK;
  finally
    Bmp.Free;
    Jpg.Free;
  end;
end;


function SaveBitmap32ToGif( AFileName: widestring; ABitmap: TBitmap32 ): byte;
var
  Gif: TGifImage;
  Bmp: TBitmap;
begin
  Result := SIR_ER;
  try
    Gif := TGifImage.Create;
    Bmp := TBitmap.Create;
    Bmp.Handle := ABitmap.BitmapHandle;
    Gif.Assign( Bmp );
    Gif.SaveToFile( AFileName );
    Result := SIR_OK;
  finally
    Gif.Free;
  end;

end;

end.
